home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #06 (Feb 86) / pascal 2.2 / Square_Wave_Scale < prev   
Text File  |  1985-12-20  |  1KB  |  62 lines
  1. program Square_Wave_scale;
  2.  const
  3.   notecount = 31;
  4.  type
  5.   Ptr = ^integer;
  6.   ParamBlockFake = array[0..30] of integer;
  7.  var
  8.   i : integer;
  9.   MySWSynthRec : record
  10.     mode : integer;
  11.     tones : array[1..notecount] of record
  12.       count, amplitude, duration : integer;
  13.      end;{ of tones }
  14.    end;{ of mySWSynthRec }
  15.  
  16.   blockA, blockB : ParamBlockFake;{ for myStartSound }
  17.   AUsed : boolean;{ for MyStartSound }
  18.  
  19.  procedure MyStartSound (SynthRec : ptr;
  20.          numbytes : longint;
  21.          CompletionRtn : Ptr);{ CompletionRtn ignored }
  22.   var
  23.    regs : array[0..12] of longint; { for generic }
  24.    BlockPtr : ^ParamBlockFake;
  25.  begin
  26.   if Aused then
  27.    BlockPtr := @BlockA
  28.   else
  29.    BlockPtr := @BlockB;
  30.   Aused := not Aused;
  31.  
  32.   BlockPtr^[12] := -4;{ set ioRefNum }
  33.   BlockMove(@SynthRec, @BlockPtr^[16], 4);{ ioBuffer }
  34.   BlockMove(@numbytes, @BlockPtr^[18], 4);{ ioReqCount }
  35.  
  36.   while BlockPtr^[8] <> 0 do { wait for ioResult }
  37.    ;
  38. { The following two lines perform  PBWrite(BlockPtr,true) }
  39.   regs[0] := ord(BlockPtr);{ set A0 for generic }
  40.   Generic($A403, regs);{ Write,async }
  41.  end;
  42.  
  43.  
  44. begin
  45.  with MySWSynthRec do
  46.   begin
  47.    mode := SWMode;
  48.    for i := 1 to notecount do
  49.     with tones[i] do
  50.      begin
  51.       count := i * 64 + 256;
  52.       amplitude := 255 - i * 8;
  53.       duration := 30;{ 1/2 sec. }
  54.      end;
  55.    myStartSound(@MySWSynthRec, sizeof(MySWSynthRec), nil);
  56.    ShowText;
  57.    Writeln('press mouse to stop');
  58.    repeat
  59.    until button;
  60.   end;
  61.  StopSound;
  62. end.